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Foreword 


The  processing  of  data  must  keep  pace  with  improvements  in  computer 
technology.  When  the  Naval  Oceanographic  Office  converted  its  basic  file 
structure  to  ASCII  Fast  and  Easy  Binary  format  it  became  advantageous  for 
the  Naval  Ocean  Research  and  Development  Activity  to  rewrite  the  CTD 
processing  program  to  match  data  formats.  This  report  describes  the 
FORTRAN  77  program  to  accomplish  this  conversion. 


R.  P.  Onorati,  Captain,  USN 
Commanding  Officer,  NORDA 


Executive  summary 


A  software  packagelwritten  in  FORTRAN  77  has  been  developed  for  proc¬ 
essing  raw  conductivity,  temperature,  and  depth  (CTD^data  to  ASCII  Fast 
and  Easy  Binary  (FEB)  format.  The  programs  contained  within  the  package 
are  machine  independent  with  the  exception  of  the  tape  block-read  routine. 
Briefly,  the  tape  header  information  is  decoded  and  checked  against  informa¬ 
tion  input  by  the  program  user,  the  raw  data  are  read  from  the  data-logger 
tape  and  converted  to  engineering  units,  the  data  are  screened  for  spurious 
data  values  and,  finally,  the  data  are  written  to  FEB  files.  Testing  was  per¬ 
formed  on  VAX  11/750  and  UNIVAC  1180  machines. 
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A  FORTRAN  77  computet  program  for  processing 
raw  CTD  data  to  ASCII  FEB  file  format 


Introduction 

Basic  input/output  file  structure,  FEB  format  (Hallock, 
1980),  for  the  physical  oceanography  branch  at  the  Naval 
Oceanographic  Office  (NAVOCEANO)  has  recently  been 
converted  to  ASCII  FEB  format  (Teague,  1984).  It  is  now 
advantageous  to  rewrite  the  CTD  processing  program 
package  in  FORTRAN  77.  This  paper  concentrates  on 
the  function  of  the  first  processing  program,  RAWRUN, 
and  describes  its  replacement,  CTDRAW.  Main  reasons 
for  the  replacement  of  RAWRUN  by  CTDRAW  follow. 

•  RAWRUN  is  written  in  FORTRAN- V,  a  language 
the  NAVOCEANO  UNIVAC  no  longer  supports. 
It  is  anticipated  that  by  the  late  1980s,  the  ability 
to  compile  FORTRAN-V  programs  on  the  UNIVAC 
will  be  lost,  which  will  ultimately  lead  to  nonwork¬ 
ing  programs. 

•  FEB  utility  programs  are  in  the  process  of  being  con¬ 
verted  to  FORTRAN  77  in  order  to  access  ASCII 
FEB  files  as  opposed  to  ‘  ‘fieldata’  ’  (a  six-bit  character 
code  native  to  the  UNIVAC)  FEB  files.  New  pro¬ 
grams  will  be  written  in  FORTRAN  77. 

•  RAWRUN  is  far  too  complicated  and  awkward  for 
updating  and  flexible  usage.  This  program  has  been 
patched  many  times  and  numerous  features  have 
become  outdated  and  unnecessary.  It  is  very  machine 
dependent  (UNIVAC),  and  its  present  structure  can¬ 
not  be  transferred  to  the  NAVOCEANO  shipboard 
computer  system  so  that  onboard  data  processing  can 
parallel  inhouse  processing. 

Discussion 

Efficiency,  simplicity,  and  easy  use  are  primary  goals 
in  CTDRAW.  Input  files  from  the  data  logger  tapes  are 
read  directly.  Output  FEB  file  attributes  and  names  are 
made  under  program  control  and  files  are  saved  on 
magnetic  tapes  under  user  control.  Although  run  streams 
(job  control)  are  not  program  generated  (the  programs 
would  then  be  machine  dependent),  the  run  streams  are 
simple,  allowing  for  maximum  flexibility  in  the  data  proc¬ 
essing.  However,  a  run-stream-generating  program  could 


be  written  specifically  for  the  UNIVAC  for  handling  the 
magnetic  tape  assignments  and  saving  files  to  tape. 

CTDRAW  is  written  entirely  in  FORTRAN  77  (com¬ 
puter  listings  are  given  in  Appendix  A)  and  is  machine 
independent  with  the  exception  of  the  tape  read 
subroutines.  Testing  of  CTDRAW  was  done  on  the  VAX 
11/750  and  the  UNIVAC  1180  machines.  The  program 
structure  is  given  below. 

CTDRAW 


READIN  PRCDAT 


UNPACK  SCREEN  HEADLD  ZWR1T 


REVBIT  UREAD  BYTE2 
(RBYTE) 

The  main  function  of  CTDRAW  is  to  read  the  Digi- 
Data  CTD  tapes  written  for  the  NBIS  MK  3  CTD  and 
to  output  the  data  in  ASCII  FEB  file  format.  No  editing 
of  the  data  is  performed  in  this  program;  however,  the 
data  are  screened  for  those  data  values  that  exceed  upper 
or  lower  bounds  and  difference  tolerances.  Diagnostic 
messages,  which  display  the  location  within  the  FEB  file 
of  the  questionable  data  values,  are  printed  in  a  diagnostic 
log  file.  These  diagnostics  are  used  for  editing  the  data 
in  later  processing  programs.  The  main  program  or  driver. 
CTDRAW,  calls  the  subroutines,  which  are  summarized. 

READIN— reads  processing  and  header  information 
from  instruction  file  format  (this  format  is  described  later). 
The  header  information  is  later  compared  with  the  header 
information  available  on  the  internal  tape  label  and  diagnos 
tic  messages  are  written  where  there  are  disagreements. 

PRCDAT —processes  the  data.  Loads  the  data  into  the 
FEB  common  block. 

SCREEN— screens  data  for  values  out  of  range  and  for 
values  exceeding  maximum  difference  tolerances.  Checks 
time  differences  between  samples  against  a  time  tolerance. 
Prints  diagnostics  for  questionable  data  values. 


HEADLD— loads  FEB  header  commons  with  the  in¬ 
formation  from  the  instruction  file  and  tape  labels. 

ZWRIT— outputs  data  and  headers  in  FEB  file  format. 

UNPACK— decodes  the  data  and  converts  the  data  to 
engineering  units. 

RBYTE— reads  the  data  tape  and  returns  2040  data 
bytes  per  tape  block  (stored  one  byte  per  word).  Tape  blocks 
are  read  with  VAX  machine  dependent  routines.  This 
routine  is  for  use  on  the  VAX. 

UREAD— reads  the  data  tape  and  returns  2040  data 
bytes  (stored  one  byte  per  word).  Tape  blocks  are  read 
with  UNIVAC  machine-dependent  routines.  This  routine 
is  for  use  on  the  UNIVAC  1180. 

BYTE2— splits  an  8-bit  byte  into  two  4-bit  bytes  con¬ 
sisting  of  the  left  4  bits  and  the  right  4  bits.  It  is  primari¬ 
ly  used  for  the  decoding  of  the  header. 

REVBIT— reverses  the  bits  in  an  8-bit  byte.  It  is  used 
in  the  decoding  of  the  time  word. 

Output  file  names  incorporate  the  station  and/or  cruise 
numbers.  For  the  UNIVAC  system  for  example,  station 
888004  of  Cruise  270485  results  in  the  ASCII  FEB  file 
named  RCTD270485  *888004  and  diagnostic  log  file 
888004LOG.  For  the  VAX  system,  output  file  names  are 
limited  to  nine  characters;  therefore,  only  the  station 
number  is  incorporated  into  the  ASCII  FEB  file  name 
(RCT888004,  for  example). 

Control  input  to  the  program  is  in  “instruction  file  for¬ 
mat.’’  In  this  format,  a  two-letter  key  identifies  the  par¬ 
ticular  input,  which  follows  this  key.  Thus,  the  control 
input  can  be  ordered  by  the  user  and  omitted  when  the 
default  values  are  appropriate.  When  conflicts  exist  be¬ 
tween  the  header  information  on  the  internal  tape  label 
and  that  supplied  by  the  instruction  file,  the  instruction 
file  information  prevails,  and  diagnostics  are  printed.  The 
defaults  are  such  that  the  program  can  run  without  any 
control  input.  All  stations  on  the  tape  are  then  processed 
to  FEB  format.  Header  information  can  be  completed  later 
with  an  editor  or  with  a  header-fill  program  (a  header-fill 
program  is  given  in  Appendix  B).  Since  the  FEB  files  are 
direct  access,  the  data  need  not  be  rewritten  while  filling 
headers.  Processing  with  minimum  user  input  could  be 
particularly  useful  when  processing  aboard  ship. 

All  tape  control  is  contained  in  the  subroutines  UREAD 
for  the  UNIVAC  and  RBYTE  for  the  VAX.  If  it  is 
necessary  to  use  other  tape  handling  subroutines,  then 
this  routine  would  require  modification.  Since  this  pro¬ 
gram  package  is  written  in  FORTRAN  77,  it  should  be 
easily  transferable  to  other  computer  systems  with  FOR¬ 
TRAN  77  compilers. 


Program  input 

Instruction  file:  a  two-letter  key  (IO,  OU,  MS,  CR,  SH, 
SN,  DM,  CN,  FI,  ST,  ET,  MM,  DT,  PT,  TT,  CT,  DI, 
GO,  QU)  followed  by  the  associated  input. 

1.  $  Input/output  control 
IO  IU 

OU  IO 
MS  MSGW 

2.  JCruise  no.,  ship,  sensor  serial  no.,  and  deployment 
mode 

CR  ICRUIS 
SH  SHIP 
SN  ISSN 
DM  MODE 

3.  SCast  no.  and  file  no. 

CN  ISTA 

FI  IHL 

4.  {Starting  times,  positions,  and  depths 

ST  YR,D A Y,RHR,RMIN ,DL AT,ML AT,DLON , 
MLON.ZBOT 

5.  {Ending  times,  positions,  and  depths 

ET  YR,DAY,RHR,RMIN,DLAT,MLAT,DLON, 
MLON  ,Z,ZBOT 

6.  JMinimum  and  maximum  pressures  expected 
MM  PMIN.PMAX 

7.  $  Sampling  interval  time  tolerance 
DT  DELTAT 

8.  {Pressure  tolerances 
PT  PLJ*H,DP 

9.  ITemperature  tolerances 
TT  TL,TH,DT 

10.  {Conductivity  tolerances 
CT  CL,CH,DC 

11.  {Diagnostic  control 
DI  ISPKS 

12.  {Process  cast 
GO 

13.  {Stop  processing  command 
QU 

The  dollar-sign  symbol,  {,  indicates  a  comment  and  has 
no  effect  on  the  processing.  A  description  of  the  input 
follows. 

1U:  Input  tape  unit  number  (default  is  3). 

IO:  Output  FEB  file  unit  number  (default  is  4). 

MSGW:  FEB  file  write  message  level  (default  is  2). 


ICRUIS:  Cruise  number  (default  to  cruise  no.  on  in¬ 
ternal  tape  label). 

SHIP;  Name  of  ship  (default  KANE). 

ISSN:  Sensor  serial  number  (default  0). 

MODE:  Deployment  mode— “VPSD”  for  single 
downcast,  “VPSU”  for  single  upcast, 
“VPSB”  for  single  down  and  upcast, 
“VPMD”  for  multiple  downcasts, 
“VPMU”  for  multiple  upcasts,  “VPMB” 
for  multiple  down  and  upcasts. 

ISTA:  Six-digit  station  number  (default  to  cast 

number  on  internal  tape  label). 

IFIL:  Input  tape  file  number  (default  to  next  file 

on  tape). 

YR:  Year. 

DAY:  Julian  day. 

TIME:  Time  (zulu). 

DLAT:  Degrees  latitude. 

MLAT:  Minutes  latitude. 

DLON:  Degrees  longitude. 

MLON:  Minutes  longitude. 

ZBOT:  Bottom  depth. 

PMIN:  Minimum  pressure  expected. 

PMAX:  Maximum  pressure  expected. 

DELTAT:  Maximum  time  interval  between  samples 
(default  is  0.0341  sec). 

PL  Pressure  tolerance  lower  bound  (default  is  0). 

PH:  Pressure  tolerance  upper  bound  (default  is 

6500). 

DP:  Maximum  pressure  difference  between 

samples  (default  is  0.5). 

TL:  Temperature  tolerance  lower  bound  (default 

is  -3.0). 

TH:  Temperature  tolerance  upper  bound  (default 

is  32.0). 

DT:  Maximum  temperature  difference  between 

samples  (default  is  0.2). 

CL  Conductivity  tolerance  lower  bound  (default 

is  10.0). 

CH:  Conductivity  tolerance  upper  bound  (default 

is  80.0). 

DC:  Maximum  conductivity  difference  tolerance 

between  samples  (default  is  0.2). 

ISPKS:  Diagnostics  printed  if  ISPKS- 1,  no 

diagnostics  printed  if  ISPKS  ■  0  (default  is  1). 

GO:  Header  information  has  been  completed, 

process  cast. 

QU:  Stop  processing  (quit)  after  this  instruction. 

When  running  the  program,  the  user  will  normally 
default  many  of  the  inputs  such  as  input/output  controls, 
deployment  mode,  diagnostic  control,  time  tolerance,  and 


pressure,  temperature,  and  conductivity  tolerances.  Cruise 
and  station  numbers  can  be  defaulted  if  the  internal  tape 
header  records  are  correct  (determined  through  a  tape  scan 
utility).  The  tape  file  number  can  be  defaulted  if  the  proc¬ 
essing  starts  at  file  one  and  no  files  need  to  be  skipped. 
Cruise  number,  ship,  sensor  serial  number,  and  deploy¬ 
ment  mode  usually  are  entered  for  only  the  first  file  to 
process,  since  these  values  are  then  maintained  for  remain¬ 
ing  files  until  changed  by  another  instruction.  Starting/end¬ 
ing  times,  positions,  and  depths  are  necessary  for  each 
cast  if  the  header  information  is  to  be  complete.  A  “GO” 
instruction  is  required  to  begin  processing  on  each  tape 
file  and  a  “QU”  instruction  is  needed  if  processing  is 
to  stop  before  a  tape  double-end-of-file  mark  is  reached. 
If  the  instruction  file  is  empty,  all  casts  will  be  processed 
until  the  tape  double-end-of-file  mark  using  defaults  and 
internal  tape  label  information. 

Sample  UNTVAC  Run  Stceam: 

®ASG,TJ  3.,U9S//////Q,TEM08.  assign  data  logger  tape 

®MAP,I  .ACTDRAW  .  create  executable  element 

IN  .CTDRAW 

IN  .READIN 

IN  .PRCDAT 

IN  .SCREEN 

IN  .HEADLD 

IN  .BYTE2 

IN  .UREAD 

IN  .UNPACK 

IN  .REVBIT 

IN  .ZWRIT 

®END 

®XQT  .ACTDRAW  .  run  the  program 

S  Process  first  three  casts  from  data  logger  tape. 

S  cruise  no. 

CR  270484 
$  ship  name. 

SH  BENT 
$  station  no. 

CN  261005 

$  starting  times,  positions,  and  depth  fix  first  station. 
ST  84., 204., 22., 12., 32., 12.1, 71., 18.3, 3682. 

S  process  first  station. 

GO 

$  station  no. 

CN  262006 

$  starting  times,  positions,  and  depth  for  second  station. 
ST  84., 206., 01., 22., 33., 11.4, 72., 44.3, 3455. 

S  process  second  station. 

GO 


$  station  no. 

CN  263007 

$  starting  times,  positions,  and  depth  for  third  station. 
ST  84.,207.,11.,34.,33., 18.0, 72,55.9,3412. 

$  process  third  cast. 

GO 

$  stop  processing 
QU 
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Appendix  A:  Program  listings 


PROGRAM  LISTINGS 

c************************************************************************* 

C  PROGRAM :  CTDRAW 

C  MAIN  PROGRAM  FOR  CONVERSION  OF  9-TRACK  DATALOGGER  TAPES 
C  WRITTEN  BY  THE  NEIL-BROWN  1150/DIGIDATA  CTD  SYSTEM. 

C 

Q************************************************************************* 

c 

WRITE (6,*)'  RAW  CTO  TO  FEB  FORMAT  PROGRAM  * 

C 

C  READ  INPUT  INSTRUCTIONS 
101  CALL  READIN(499) 

C 

C  PROCESS  THE  CAST 

CALL  PRCDAT(492,495) 

C 

C  READ  INSTRUCTIONS  FOR  NEXT  CAST 
GO  TO  101 
C 

92  WRITE (6,*)'  ERROR  IN  PROCESSING  DATA  IN  SUBROUTINE  PRCDAT 1 
STOP 
C 

95  WRITE (6,*)'  DOUBLE  EOF  REACHED' 

C 

99  WRITE(6,*)‘  END  OF  JOB' 

STOP 

END 


c***************^******************^************  ♦♦♦»»»*»»*»♦»»*» 

c 

C  SUBROUTINE  READIN 

C  THIS  SUBROUTINE  READS  INPUT  INSTRUCTIONS  AND  SETS  DEFAULTS  FOR 
C  MAIN  PROGRAM,  CTDRAW. 

C 

£*******★****************•**** ************** ******* **************** 

c 

SUBROUTINE  READIN (*) 

C 

IMPLICIT  REAL *4  (A-H,  O-Z) 

IMPLICIT  INTEGER*4  ( I ,J,K,L,M,N) 

C 

CHARACTERS  A 
CHARACTERS  DM 
CHARACTER*24  SHIP 
CHARACTERS  2  ISSN 
CHARACTER*? 2  IN 
C 

COMMON  /COMTOL/  DELTAT,PL,PH,DP,TL,TH,DT,CL,CH,DC, ISPKS 
COMMON  /COMIO/  IU,IOU,MSGWl,ICRUI$,ISTA,IFIL 
COMMON  /COMTIM/  YR , DAY , RHR , RM IN , DLAT , RMLAT , DLON , 

&  RML0N,ZB0T,YR1,DAY1,RHR1,RMIN1,DLAT1,RMLAT1,DL0N1, 

A  RMLONl,ZBOTl,PMIN,PMAX 

COMMON  /COMALP/  SHIP, DM, ISSN 
C 

C  SET  DEFAULTS 

DATA  IU,IOU,IFIL,MSGWl  /3,4,1,2/ 

DATA  IPRNGE.DELTAT, ISPKS  /6500, .0341,1/ 

DATA  PL, PH, DP  /O. ,6500. ,0.5/ 

DATA  TL.TH.DT  /-3. 0,32. 0,0.2/ 

DATA  CL.CH.DC  /10. ,80. ,0. 2/ 

D»T4  SHIP, DM  /'KANE'.'VPSD'/ 

C 

Q*******************************+********************************** 

c 

C  OPEN  SCRATCH  FILE  TO  ALLOW  LIST  DIRECTED  READ 
CLOSE (UNIT=29) 

0PEN(UNIT=29,STATUS= 'SCRATCH ' ,ERR*9096) 

C 

C  READ  INPUT  INTO  INTERNAL  FILE 
10  READ ( 5 , 5000 , ERR=9000 , END=999 ) I N 

5000  FORMAT(A) 

C  WRITE  INSTRUCTION  TO  UNIT  29 
WRITE (29, 5000) IN (4: 72) 

BACKSPACE  29 
C 

Q**************************************** ***************************** 

c 

C  TRANSLATE  INSTRUCTION 
A=IN (1:2) 

C 

C  READ  COMMENT 

IF(A(1:1).EQ. '$' .OR . A( 1 : 1 ) .EQ. 'S' )G0  TO  10 


READ  INPUT  TAPE  UNIT  NO. 

IF(A.EQ. ' IU ' .OR.A.EQ. '1u' )TH£N 
READ(29,*,ERR=9097)IU 
GO  TO  10 
END  IF 

READ  OUTPUT  FEB  FILE  UNIT  NO. 

IF( A.EQ . 'OU 1 .OR.A.EQ. 'ou' )THEN 
READ(29,*,ERRS9097)I0U 
GO  TO  10 
END  IF 

READ  FEB  FILE  WRITE  MESSAGE  LEVEL  (MSGW) 
IF( A. EQ . 'MS' .OR.A.EQ. 'ms' )THEN 
READ (29 , * ,ERR=9097 )MSGW1 
GO  TO  10 
END  IF 

READ  CRUISE  NO. 

IF ( A. EQ. 'CR' .OR.A.EQ. 'cr' )THEN 
READ ( 29 , * , ERR=9097 )  ICRU IS 
GO  TO  10 
END  IF 

READ  SHIP  NAME 

IFCA.EQ. 'SH ' .OR.A.EQ. ' sh‘ )THEN 
SHIP=IN(4:27) 

GO  TO  10 
END  IF 

READ  SENSOR  SERIAL  NO. 

IF(A.EQ. *SN ' .OR.A.EQ. 'sn' )THEN 
ISSN=IN(4: 15) 

GO  TO  10 
END  IF 

READ  DEPLOYMENT  MODE 

IF(A.EQ. 'DM' .OR.A.EQ. 'dm' )THEN 
DM=IN(4:9) 

GO  TO  10 
END  IF 

READ  CAST  NO. 

IF ( A . EQ. 'CN ' .OR.A.EQ. 'cn' )THEN 
READ (29,*,ERR=9097 )ISTA 
GO  TO  10 
END  IF 

READ  INPUT  TAPE  FILE  NO. 

IF(A.EQ. 'FI ' .OR.A.EQ. ’ fl ' )THEN 
READ(29,*,ERRa9097)IFIL 
GO  TO  10 


c 

C  READ  STARTING  TIMES,  POSITIONS,  AND  DEPTHS 
IF(A.EQ. 'ST' .OR.A.EQ. 'st' )THEN 

READ (2  9 , * , ERR=9097 ) YR , DA Y , RHR , RM IN , DLAT , RMLAT , DLON , RMLON , ZBOT 
GO  TO  10 
END  IF 
C 

C  READ  ENDING  TIMES,  POST IONS,  AND  DEPTHS 
IF(A.EQ. 'ET' .OR.A.EQ. 'et' )THEN 

READ(29,*,ERR=9097)YR1,DAY1,RHR1,RMIN1,DLAT1,RMLAT1,DL0N1,RML0N1 
A  ,ZB0T1 
GO  TO  10 
END  IF 
C 

C  READ  MAX  TIME  INTERVAL  BETWEEN  SAMPLES 
IF(A.EQ. 'DT' .OR.A.EQ. 'dt' )THEN 
READ ( 29 , * , ERR=9097 )DELTAT 
GO  TO  10 
END  IF 
C 

C  READ  PRESSURE  TOLERANCES 

IF(A.EQ. 'PT ' .OR.A.EQ. 'pt' )THEN 
READ(29,*,ERR=9097)PL,PH,DP 
GO  TO  10 
END  IF 
C 

C  READ  TEMPERATURE  TOLERANCES 

IFtA.EQ. 'TT' .OR.A.EQ. 'tt' )THEN 
READ ( 29 ,* , ERR=9097 )TL , TH , DT 
GO  TO  10 
END  IF 
C 

C  READ  CONDUCTIVITY  TOLERANCES 

IF(A.EQ. 'CT' .OR.A.EQ. 'ct' )THEN 
READ(29,*,ERR=9097)CL,CH,DC 
GO  TO  10 
END  IF 
C 

C  READ  DIAGNOSTICS  PRINTOUT  CONTROL  {1  FOR  YES,  0  FOR  NO) 

IF(A.EQ. 'DI ' .OR.A.EQ. ' dl ' )THEN 
READ(29,*,ERR=9097)ISPKS 
GO  TO  10 
END  IF 

C  READ  MIN  AND  MAX  PRESSURES  EXPECTED 
IF(A.EQ. 'MM' .OR.A.EQ. 'mm' )THEN 
READ(29,*,ERR=9097)PMIN,PMAX 
GO  TO  10 
END  IF 
C 

C  PROCESS  CAST 

IFIA.EQ. 'GO' .OR.A.EQ. 'go' )RETURN 
C 

C  STOP  PROCESSING 

IFfA.EQ. 'QU ' .OR.A.EQ. 'qu* )THEN 


•AWffS! 


WRITE (6,*) 'PROCESSING  TERMINATED  ON  "QU"  COMMAND1 
RETURN 1 
END  IF 
C 
C 

Q******************************************** ************************** 

c 

9000  WRITE (6,*)' ERROR  IN  READING  INSTRUCTION,  TRY  AGAIN1 
GO  TO  10 

9096  WRITE(6,*) 'ERROR  IN  OPENING  UNIT  29,  DO  NOT  USE  UNIT  29!' 

STOP 

9097  WRITE(6,*) ‘ERROR  WHILE  READING  INSTRUCTION  '.A,'  TRY  AGAIN' 

GO  TO  10 

999  RETURN 
END 


p******************************************************* ********* ********** 

c 

SUBROUTINE:  PRCDAT 

THIS  PROGRAM  PROCESSES  THE  RAW  CTO  DATA  AND  WRITES  DATA 
TO  FEB  FORMAT 


Q*************************** ********************************* ************** 

c 

SUBROUTINE  PRCDAT (*,*) 


C 

C 


C 

C 


C 

C 


IMPLICIT  REALM  (A-H.O-Z) 
IMPLICIT  INTEGERM  (I,J,K,L,M,N) 


CHARACTERS  DM 
CHARACTERS 2  ISSN 
CHARACTERS  SHIP 

CHARACTERS  ADOCW , I PW , NMFW , NMBW , PNW , RNW 


COMMON  /COM 10/  IU,I0U,MSGW1,ICRUIS,ISTA,IFIL 

COMMON  /COMTOL/  DELTAT,PL,PH,OP,TL,TH,DT,CL,CH,DC,ISPKS 

COMMON  /COMALP/  SHIP, DM, ISSN 


COMMON  /HEDDAT/  KPCODE , KTC AST , KDA Y , KSTA , KCRU I S 
COMMON  /ENGDAT/  PP(170),TT(170),CC(170),HH(170) 


ZWRIT  COMMON  AREAS 

COMMON  /  WHDR  /LW,NW,NBW,NFW,NIW,NAW 
COMMON  /  WHDR1  /NMBW, NMFW, PNW, RNW, I PW (4) 

COMMON  /  WDOCF  /FD0CW(25)  /WD0CI/ID0CW(15)  /WD0CA/AD0CW(72) 
COMMON  /  WDATA  /  VW(4,1000) 

COMMON  /  DIAGS  /  MSGR , MSGW , NNNR , NNNW , NN IP , NNF , NN I , NNA , I RST , I WST 


REALM  MINMAX(6) 


DATA  NNNW,NNIP,NNF,NNI ,NNA/1000,4,25, 15,72/ 
DATA  IPW/'RELSEC' , 'PRESS  ' , 'TEMP  ','COND  7 
DATA  I OPEN  /O/ 

DATA  ISCAN  101 


£********************** ********************* ******************************* 
MSGW=MSGW1 
JFILSFIL 
IUNIT*IU 
ISW=1 
ISEG*0 
I DOC W 1*1 
LW*4 
C 

101  NBWP1*NBW+1 
C 


GET  A  DATA  RECORD 

IF  IE0F=0  THEN  DATA  RECORD  IS  RETURNED 
IF  IEOF=l  THEN  END  OF  FILE  REACHED 
IF  IE0F=2  THEN  DOUBLE  END  OF  FILE  REACHED 

IF(ISCAN.EQ.O)CALL  UNPACK(IUNIT.JFIL.IEOF) 
IF(IEOF.GE.I )ISCANsO 

IF(IEOF.EQ.l)THEN 
I OPEN =0 

CHECK  TO  SEE  IF  ANY  DATA  HAS  BEEN  LOADED  TO  VW 
IF(NW.EQ.l )G0  TO  211 
GO  TO  210 
END  IF 

IF ( I EOF . EQ . 2 )RETURN2 


ISCAN=ISCAN+1 

P=PP(ISCAN) 

T=TT(ISCAN) 

C*CC(ISCAN) 

H=HH(ISCAN) 

IF(ISCAN.EQ. 170)ISCAN=0 


CHECK  HEADER  RECORD 
IF(ISW.EQ.1)THEN 
ISW*0 

IF(ISTA.NE.O)THEN 
WRITE (NMBW, 6010 JISTA 
ELSE 

WRITE (NMBW, 6010 )KSTA 
END  IF 

IF(ICRUIS.NE.O )THEN 
WRITE (NMFW.6010 )ICRUIS 
ELSE 

WRITE (NMFW, 6010 )KCRUIS 
0  FORMAT (16) 

END  IF 

REFTIM=KDAY 


OPEN  FEB  AND  LOG  FILE 
IF(IOPLN.EQ.O)THEN 
CLOSE (UNIT*28) 

CLOSE (UNIT*IOU) 

I0PEN*1 

JSEG*1 

IF(ISPKS.EQ.1)0PEN(UNIT*28,FILE"NMBW// 'LOG' .STATUS*' NEW' , 
*  ERR*9094) 

NOTE:  IF  RECL-IBUF  IN  ZWRIT  CHANGES,  RECL  HERE  MUST  BE  CHANGED 


ooooooooo 


C  RCDS  IS  SPECIFIED  SO  THAT  THE  UNIVAC  FILE  CAN  BE  LARGER  THAN  THE 
C  DEFAULT  TRACK  LIMIT  OF  128;  15000  ALLOWS  FOR  ABOUT  5000  TRACKS. 

C  RCDS  IS  SPECIFIC  TO  THE  UNIVAC  AND  IS  NOT  USED  ON  THE  VAX. 

C  THE  FOLLOWING  OPEN  STATEMENT  IS  FOR  THE  VAX 

OPEN {UN IT-I OU  ,F  ILE  = ' RCT ' //NMBW , FORM- ' UNFORMATTED 1 , 

*  ACCESS- 'DIRECT* .RECL-600, STATUS- 'NEW'  .ERR-9095) 

WRITE (6 , * ) 

WRITE (6,*) 'WRITE  FEB  FILE:  ' , ' RCT ‘ //NMBW 
WRITE (28,*) 'FEB  FILE:  'RCT '//NMBW 
WRITE (6 ,*) 

THE  FOLLOWING  OPEN  STATEMENT  IS  FOR  THE  UNIVAC 

OPEN (UN IT-IOU ,F I LE- ’ RCTD ' //NMFW// ' * ' //NMBW, FORM* ' UNFORMATTED 

*  ACCESS- ' D I RECT ' , RECL  =600 , ST ATUS  * ' NEW ' .RCDS-15000, 

*  ERR-9095) 

WRITE(6,*) 

WRITE (6,*) 'WRITE  FEB  FILE:  ', 'RCTD '//NMFW//' *'//NMBW 
WRITE (28,*) 'FEB  FILE:  ', 'RCTD '//NMFW//'*' //NMBW 
WRITE (6,*) 

END  IF 
C 

WRITE (6, 2000 JREFTIM 

2000  FORMAT!//'  REFERENCE  TIME  FROM  HEADER  =',G11.5,'  DAYS'//) 

C 

IF(KCRUIS.NE.ICRUIS)WRITE(6,2100)ICRUIS,KCRUIS 

2100  FORMAT ( / '  CRUISE  NUMBERS  OISAGREE.  SUPPLIED:  ',16, 

*  '  ON  LOGGER  TAPE:  ',16//) 

C 

C  CHECK  CAST  NO.  (I.E.  LAST  3  DIGITS) 

ISTA3=M0D(ISTA,1000) 

IF(KSTA.NE.ISTA3)WRITE(6,2101)ISTA3,KSTA 

2101  FORMAT*/'  CAST  NUMBERS  DISAGREE.  SUPPLIED:  ',16, 

*  '  ON  LOGGER  TAPE:  ',16//) 

C 

END  IF 
CC 
C 

C  LOAD  DATA  INTO  FEB  COMMON 
VW(1,I )=H 
VW (2,1 )-P 
VW(3,I )*T 
VW{4, I )*C 
C 

C  SCREEN  THE  DATA 

CALL  SCREEN (NBWP1 , I , H , P , T ,C .MINMAX ,NTDI AG, NDDIAG ) 

PMAX=MINMAX(2) 

C 

200  CONTINUE 
C 

210  ISEG-ISEG+1 
C 

C  UPDATE  END  OF  SERIES  FLAG  AND  REL.  PROF.  NO. 

ID0CW(1 )-IEOF 
NBW1-NBW+1 


WRITE (RNW , 21 10 )NBW1 
2110  FORMAT (16) 

:  WRITE  FULL  HEADER  RECORO  ONLY  FOR  FIRST  SEGMENT 
IF(ID0CW1.EQ.1)THEN 
NFWs25 
NIW-15 
NAW=72 

:  LOAD  THE  HEADERS  INTO  FEB  COMMON 

CALL  HEADLD 
ELSE 
NFW*0 
NIW*1 
NAW=0 
END  IF 

% 

:  WRITE  THE  DATA  TO  A  FEB  FILE 

CALL  ZWRIT(IOU, IF.JSEG) 

:  ZWRIT  ERROR  RETURN 

IF(IF.NE.O)  RETURN 1 
ID0CW1SID0CW(1 ) 

JSEG-JSEG+1 

:  GET  MORE  DATA 

IF(IEOF.EQ.O)GO  TO  101 

* 

:  ON  END  OF  FILE  WRITE  CAST  SUMMARY  INFORMATION 

211  WRITE (6,6100)MINMAX 
6100  FORMAT (//'  CAST  COMPLETE.'// 

*  '  PMIN=' ,G12.6, ' ;  PMAX*' ,G12.6// 

*  '  TMIN=',G12.6,';  TMAX*' ,G12.6// 

*  '  CMIN=',G12.6,';  CMAX»' ,G12.6//) 

WRITE(6,*) 

WRITE(6,*)‘  NO.  OF  DIAGNOSTICS' 

WRITE(6,*) '  TIME:  ' ,NTDIAG 

WRITE(6,*) '  COND.,  TEMP.,  AND  DEPTH:  '.NDDIAG 

% 

* 

RETURN 

9094  WRITE(6,*) ’ERROR  IN  OPENING  LOG  FILE,  UNIT  28’ 
STOP 

9095  WRITE (6,*) 'ERROR  IN  OPENING  FEB  FILE,  UNIT  ',IOU 
STOP 

END 


\ik  ■ 


m 

•Vtv 


«%-■ 


m 


c **************************************************************************** 

c 

C  SUBROUTINE  SCREEN 

C  THIS  ROUTINE  CHECKS  FOR  WILD  POINTS  IN  P,  T,  C,  AND  TIME,  AND  COUNTS 
C  THE  NO.  OF  WILD  POINTS  (ITDIAG  FOR  TIME,  AND  IDDIAG  FOR  P,  T,  AND  C). 

C 

£*****★*★*****★★*****★★★★**★*★**★★***★*★****************************★★******** 

c 

SUBROUTINE  SCREEN (NBWZ.KCYC.TYME, PRES, TEMP, COND, 

*  MINMAX, ITDIAG, IDDIAG) 

C 

IMPLICIT  REAL*4  (A-H.O-Z) 

IMPLICIT  INTEGERS  ( I,J,K,L,M,N) 

C 

CHARACTER*2  JFLG(6) 

C 

COMMON  /COMTOL/  DELTAT,PL,PH,DP,TL,TH,DT,CL,CH,DC,ISPKS 
C 

REALM  MINMAX  (6) 

C 

ISSW-1 

TIMTOL=DELTAT 
DO  1  1-1,6 

1  JFLG(I )='  ' 

C 

IF ( (KCYC.LT.3) .AND. (NBWZ.LT.2) )  THEN 
C 

PPRES-PRES 

PTEMP-TEMP 

PCOND-COND 

PTYME-TYME 

PMIN-IOOOO. 

PMAX--10. 

TMIN-IOO. 

TMAX--10. 

CMIN-IOO. 

CMAX--10. 

C 

END  IF 
C 

IF(PRES.LT.PL)  JFLG{l)-'LO' 

IF(PRES.GT.PH)  JFLG(1)“'HI ' 

IF(ABS(PRES-PPRES) .GT.DP)  JFLGm-’CH' 

C 

IF(TEMP.LT.TL)  JFLGOJ-’LO* 

IF(TEMP.GT.TH)  JFLG(3)-'HI' 

IF(ABS(TEMP-PTEMP) .GT.DT)  JFLG(4)»'CH' 

C 

IF(COND.LT.CL)  JFLG(5)-'L0' 

IF(COND.GT.CH)  JFLG(5)='Hr 
IF(ABS(COND-PCOND) .GT.DC)  JFLG(6)-'CH’ 

C 

DO  2  J-1,6 

2  IF(JFLG(J ).NE. '  ')  ISSW-2 


If 

M  A  •’ 


4U? 


I  .£*>/; 


IW'1. 

I*A\ 


TMDIFF*TYME-PTYME 

KCYCP=KCYC-1 

IF(TMDIFF.GT.TIMTOL)THEN 

IF ( ISPKS.EQ. 1 )MRITE (28,6011 )  NBWZ.KCYCP, 

*PTYME , KC YC , TYME , TMDIFF .TIHTOL 
6011  FORMAT ( 1  TIME  DIFF.  IN  SEG.  ', 

*14,'  BETWEEN  CY.',I4,'  TIME*' ,F12.4, '  AND  CY. * , 

*14,'  TIME®' ,F12.4,'  OIFF.®' ,F8.4, '  MAX-' ,F6.4,T132, '$' ) 

ITDIAG=ITDIAG+1 

END  IF 

IF(ISSW.EQ.l)  THEN 
PPRES=PRES 
PTEMP=  TEMP 
PCOND=  COND 
PTYME=TYME 

% 

IF(PRES.GT.PMAX)  PMAX=PRES 
IF(PRES.LT.PMIN)  PMIN=PRES 
IF(TEMP.GT.TMAX)  TMAX=TEMP 
IF (TEMP. LT. TWIN)  TMIN=TEMP 
IF(COND.GT.CMAX)  CMAX®C0ND 
IF(COND.LT.CMIN)  CMIN=COND 

MINMAXfl )=PMIN 
MINMAX(2)=PMAX 
MINMAX(3)=TMIN 
MINMAX(4)=TMAX 
MINMAX(5)=CMIN 
MINMAX(6)*CMAX 

RETURN 

C 

END  IF 

C 

PDIFF®PRES-PPRES 
TD I FF  =TEMP -PTEMP 
CDIFF®COND-PCOND 

: 

IF ( I SPKS . EQ . 1 )WRITE (28,6)  NBWZ,KCYC,JFLG(1),JFLG(2),PRES,PDIFF, 
*JFLG (3 ) ,  JFLG (4 ) ,TEMP,TDIFF , JFLG (5 ) .JFLG (6) ,COND,CDIFF 
C 

6  FORMAT ('  SEG  ',14,'  CYCLE  ' ,I4,3X,A2, 7‘ ,A2, ' .PRES®' , 
*G12.6,7',G10.4,3X,A2,7',A2,,.TEMP»',G12.6,7', 

*G10.4,3X,A2, ,A2, ' .COND® ' .G12.6, 7* .G10.4.T132, '$ ' ) 

C 

IDDIAG*IDDIAG+1 


PPRES-PRES 


V’v-v 


TV * 


o  o  o  o  o  oo  oooooo 


£**★****★*********★****** ******************************************** ********* 
SUBROUTINE  HEADLD 

THIS  ROUTINE  LOADS  FEB  HEADER  COMMON  AREAS. 
*★*****★*****★**★***■**★*******★★*★***★★*♦*******★****★★****★******★*******★♦* 

SUBROUTINE  HEADLD 


IMPLICIT  REAL *4  (A-H.O-Z) 

IMPLICIT  INTEGERS  (I,J,K,L,M,N) 

CHARACTERS  ADOCW,  IP  W ,  NMF W ,  NMBW ,  PNW ,  RNW 
CHARACTERS  DM 
CHARACTER*24  SHIP 
CHARACTERS  2  ISSN 
CHARACTERS  MDY.ITIM 

COMMON  /COM 10/  IU, I0U.MSGW1, ICRUIS.ISTA, IFIL 
COMMON  /COMTOL/  DELTAT,PL,PH,DP,TL,TH,DT,CL,CH,DC,ISPKS 
COMMON  /COMTIM/  YR1 , DAY1 , RHR1 , RMI N1 , DLAT1 , RMLAT1 , DL0N1 , 

&  RML0N1,ZB0T1,YR2,DAY2,RHR2,RMIN2,DLAT2,RMLAT2,DL0N2, 

St  RML0N2 ,  ZB0T2 ,  PM  I N ,  PMAX 

COMMON  /COMALP/  SHIP, DM, ISSN 

ZHRIT  COMMON  AREAS 

COMMON  /  WHDR  /LW,NW,NBW,NFW,NIW,NAW 
COWON  /  WH0R1  /NMBW, NMFW, PNW, RNW, IPW (4) 

COMMON  /WD0CF/FD0CW(25)  /WD0CI/ID0CW(15)  /WD0CA/AD0CW(72) 

C 

DATA  ADOCW  /72*’  '/ 

C 

Q**************************************************************************** 

c 

PNW*' 

C 

FDOCWfl )SYR1 

FD0CW(2)=DAY1 

FD0CW(3 )=RHR1 

FD0CW(4)*RMIN1 

FD0CW(5)=DLAT1 

FD0CW(6)3RMLAT1 

FD0CW(7 )=DL0N1 

FD0CW(8)=RML0N1 

FD0CW(9)»ZB0T1 

FD0CW(10)=YR2 

FD0CW(11)*DAY2 

FD0CW(12 )aRHR2 

FD0CW(13)*RMIN2 

FD0CW(14)*DLAT2 

FDOCW (15) aRML AT  2 

FD0CW(16)*DL0N2 


•  'V  m  +  '  ♦ ' 1  «**  I 


FDOCW(17)=RMLON2 

FD0CW(18)=ZB0T2 

FD0CW(19)*PMIN 

FD0CW(20)*PMAX 

FD0CW(21 )*.032 

FDOCW(22)-.032 

FD0CW(23)*DELTAT 

ID0CW(2 )=ICRUIS 
ID0CW(3)*ISTA 
ID0CW(11 )=6500 

AD0CW(1)*SHIP(1:6) 
AD0CW(2)=SHIP(7:12) 
AD0CW(3)sSHIP(13: 18) 
AD0CW(4)=SHIP(19:24) 
AD0CW(5)«'DB' 

A00CW(6)='SEC' 

AD0CW(7 )= 'SEC ' 

AD0CW(58)=DM 

AD0CW(59)='CTD' 

AD0CW(60)= 'NB3 1 
AD0CW(61 ) =1 SSN (1:6) 

ADOCW (62 ) =1  SSN (7:12) 

UNIVAC  DATE  ROUTINE 
CALL  ADATE(MDY.ITIM) 
AD0CW(66)=MDY(1:6) 

END  UNIVAC  DATE  SETUP 
HODAS  DATE  ROUTINE 
CALL  ? 

VAX  DATE  ROUTINE 
CALL  I DATE (JMO.JDA, JYE ) 
WRITE(AD0CW(66),600)JM0,JDA,JYE 
600  FORMAT (31 2) 

END  VAX  DATE  SETUP 

RETURN 

END 


ly 


i 
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c************************************************************************* 

SUBROUTINE  BYTE2 

THIS  SUBROUTINE  SPLITS  AN  8  BIT  BYTE  INTO  TWO  4  BIT  BYTES. 

IT  RETURNS  THE  LEFT  4  BITS  (IL)  AND  THE  RIGHT  4  BITS  (IR). 

£**************★**★**★*********★★****★****★**★**★*********★*★★***★*★★*★**★* 
SUBROUTINE  BYTE2(IBYTE,IL, IR) 

C 

IMPLICIT  REAL *4  (A-H.O-Z) 

IMPLICIT  INTEGER*4  (I.J.K.L.M.N) 

C 

IN=16 

IL=IBYTE/IN 

IRaIBYTE-IL*IN 

RETURN 

END 


Q  ■kirkirk'k'kirk'k’k'k'kirk-kic'kirkirkirkirkirkic'kirk-kirkirkirk  ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★*★★*★*★★ 

c 

C  SUBROUTINE  RBYTE 

C  THIS  SUBROUTINE  READS  THE  CTO  DATA  LOGGER  TAPE  (NAVOCEANO  FORMAT)  AND 
C  RETURNS  2040  DATA  BYTES  (STORED  1  BYTE  PER  WORD). 

C  THIS  SUBROUTINE  IS  DESIGNED  FOR  USEAGE  ON  A  VAX  11/750. 

C 

£*****★***************★★**★**★**★★*★★★★★★*★★*★*★★★***★*★★*★★*★*****★*******★* 

c 

SUBROUTINE  RBYTE (IUNIT, IFIL.JREAD, IFLG) 

C 

IMPLICIT  REAL *4  (A-H.O-Z) 

IMPLICIT  INTEGERS  (I,J,K,L,M,N) 

C 

BYTE  I READ (2044) 

DIMENSION  JREAD(l) 

INTEGER*2  I UNIT, NI READ 
DATA  NIREAD.ICK  /2043.0/ 

C  N I READ  IS  SET  TO  2043  SINCE  THE  TAPE  IS  COPIED  VIA  THE  UN I VAC,  A  36-BIT 
C  WORD  MACHINE  (2043  X  8  IS  DIVISIBLE  BY  36). 

C 

C  SET  TAPE  CHARACTERISTICS  FOR  INITIAL  READ 
IF(ICK.EQ.O)THEN 

CALL  TCHAR( IUNIT, 'MSAO: '.'BINARY V 1600* , ’ODD 1 ) 

ICK=1 

C 

C  POSITION  TAPE  TO  STARTING  FILE 
ISKIP=IFIL-1 
IF( ISKIP.GT.O)THEN 
CALL  TFILESKIP(IUNIT, ISKIP, ISTAT) 

IF(ISTAT.NE.1)THEN 

WRITE(6,*) '  PROBLEM  IN  POSITIONING  TAPE  UNIT', IUNIT 
STOP 
END  IF 
END  IF 
C 

END  IF 
C 

C  READ  TAPE  RECORD 

CALL  TREAD (I UN IT , I READ , NI READ , I STAT ) 

C 

C  CHECK  STATUS  OF  READ 

C  SET  STATUS  FLAG:  IFLG=0  FOR  DATA  READ,  =1  FOR  EOF,  =2  FOR  ERROR. 

IFLG=0 

C  CHECK  FOR  END  OF  FILE 

IF (ISTAT. EQ. 2160 )THEN 
IFLG=1 
RETURN 
END  IF 

C  CHECK  FOR  PROBLEM  DURING  READ 
IF(NIREAD.LE.0)IFLG=2 
IF(  ISTAT.  NE.DTHEN 
IFLG=2 
RETURN 


END  IF 


BYTE  RANGE  ON  VAX  IS  -127  TO  +128 

WANT  RANGE  OF  0  TO  +255,  SO  ADO  256  TO  NEGATIVE  DATA  BYTES 
DO  IJ=1,NIREAD 
JREAD ( I J ) *IREAD ( I J ) 

IF{ JREAD ( I J ) . LT . 0 ) JREAD (IJ )SJ READ ( I J )+256 
0 


1 1 


if  CW*  v.  V J. * 


v  I  *f.  'v  yjt  j 


i  S-«Cvi 


£******************************************************************* 

c 

C  SUBROUTINE  UREAD 

C  THIS  SUBROUTINE  READS  THE  CTD  DATA  LOGGER  TAPE  (NAVOCEANO  FORMAT) 

C  AND  RETURNS  2040  DATA  BYTES  (STORED  1  BYTE  PER  WORD). 

C  THIS  SUBROUTINE  IS  DESIGNED  FOR  USEAGE  ON  A  UNIVAC  1180. 

C 

C************************** ************************************************ 

c 

SUBROUTINE  UREAD ( IUN IT , IF IL , JREAD , IFLG ) 

C 

IMPLICIT  REAL *4  (A-H.O-Z) 

IMPLICIT  INTEGERS  (I,J,K,L,M,N) 

C 

DIMENSION  I READ (510),IB YTE ( 4 ) , JREAD (2044) 

C 

DATA  NIREAD, I EOF/510,1/ 


POSITION  TAPE  BY  FILE 
IF(IE0F.EQ.1)THEN 
ISKIP=IFIL-1 
IE0F=0 

IF(ISKIP.GT.O)CALL  NTRAN$(IUNIT,8, ISKIP ) 

END  IF 

READ  TAPE  RECORD 

CALL  NTRAN$(IUNIT, 3, NIREAD, IREAD, IST,22) 

IGNORE  UNIVAC  WARNING  1806,  NO.  OF  ARGUMENTS  IS  CORRECT 

CHECK  STATUS  OF  READ 

SET  STATUS  FLAG:  IFLG=0  FOR  DATA  READ,  =1  FOR  EOF,  =2  FOR  ERROR 
IFLG=0 

CHECK  FOR  END  OF  FILE 
IF ( IST.EQ. -2 )THEN 
IFLG=1 
IE0F=1 
RETURN 
END  IF 

CHECK  FOR  PROBLEM  DURING  READ 
IF(NIREAD.LE.O)THEN 
IFLG=2 
RETURN 
END  IF 

IF(IST.LT.-2)THEN 
IFLG=2 
RETURN 
END  IF 

SEPARATE  BYTES  INTO  1  PER  WORD 

LCT=1 

IN=512 

N*1 


I'i* 


3  ICTSICT+1 

C  RESET  COUNTER  AT  END  OF  TAPE  BLOCK 
C 

IF ( I CT . EQ . 51 1 )THEN 
ICTsO 
RETURN 
C 

END  IF 

I VAR*! READ ( I CT) 

1  CONTINUE 

I11*IVAR/IN 

I1*I11*IN 

IBYTE(N)=IVAR-I1 

IVAR=I11 

N=N+1 

C  LOAD  EACH  BYTE  INTO  JREAD 
IF(N.EQ.5)THEN 
JREAD (LCT )=I8YTE (4 ) 

JREAD(LCT+1 )*IBYTE(3) 

JREAD (LCT+2 )=IBYTE{2 ) 

J  READ ( LCT+3 ) * I BYTE ( 1 ) 

N=1 

LCT*LCT+4 
GO  TO  3 


Q***************************************************************************** 

c 

C  SUBROUTINE  REVBIT 

C  THIS  SUBROUTINE  REVERSES  THE  BITS  IN  AN  8-BIT  BYTE. 

C 

I;****************************************************************************** 

C 

SUBROUTINE  REVBIT(INUM,MUNI ) 

C 

IMPLICIT  REAL *4  (A-H,0-Z) 

IMPLICIT  INTEGERS  (I,J,K,L,M,N) 

C 

DIMENSION  KB(16),JREV(256) 

C 

C  KB  CONTAINS  THE  VALUE  OF  A  4  BIT  BYTE  FOR  1=1-15, 

C  AFTER  THE  BITS  OF  I  HAVE  BEEN  REVERSED. 

C  EX.  1=1  (0001)  THEN  KB(1)=8  (1000). 

DATA  KB  /0,8,4,12,2f10,6,14,l, 9, 5, 13,3,11, 7,15/ 

C 

DATA  IPASS  /O/ 

C 

C  CALCULATE  THE  VALUE  OF  AN  8  BIT  BYTE  UPON  REVERSING 
C  THE  BITS.  THIS  NEEOS  TO  BE  DONE  ONLY  ONCE,  SAVE  IN  JREV. 

C  TECHNIQUE:  SPLIT  8  BIT  BYTE  INTO  TWO  4  BIT  BYTES  AND 

C  LOOK  UP  IN  KB  THE  REVERSE  OF  THE  4  BIT  BYTES.  THEN 

C  RECOMBINE  INTO  AN  8  BIT  BYTE  (REVERSED). 

IF(IPASS.EQ.O)THEN 
IPASS=1 
JREV(1 )=0 
DO  10  1=1,255 
CALL  BYTE2(I,IL,IR) 

10  JREV ( 1+1 )=KB{ IR+1 )*16  +  KB(IL+1) 

END  IF 
C 

IF{ INUM.LT.O.OR. INUM.GT.255)GO  TO  900 
MUNI=JREV(INUM+1 ) 

C 

RETURN 

900  WRITE(6,*) '  PROBLEM  IN  REVBIT  SUBROUTINE' 

END 


Q****************************************************************************** 

c 

C  SUBROUTINE  UNPACK 

C  THIS  SUBROUTINE  UNPACKS  THE  HEADER  AND  DATA  BLOCKS,  RETURNING  THE  HEADER 
C  INFORMATION  AND  DATA  RECORDS  IN  ENGINEERING  UNITS. 

C 

c****************************************************************************** 

c 

SUBROUTINE  UNPACK(IUNIT, IFIL, IEOF) 

C 

IMPLICIT  REAL *4  (A-H.O-Z) 

IMPLICIT  INTEGERS  (I,J,K,L,M,N) 

C 

COMMON  /ENGDAT/  PP(170),n(170),CC(170),HH(170) 

COMMON  /HEDDAT/  IPCODE,ITCAST,JDAY,ISTA,ICRUIS 
DIMENSION  IBUF ( 2044 ) 

DATA  IREC.IM  /0.256/ 

C 

Q******** **************** ******************************************************* 

C 

C  READ  A  TAPE  RECORD 
C 

C  FOR  VAX 

10  CALL  RBYTE(IUNIT, IFIL, IBUF, IFLG) 

C 

C  FOR  UN I VAC 

CIO  CALL  UREADdUNIT, IFIL, IBUF, IFLG) 

C 

C  COUNT  TAPE  BLOCKS  READ 
IREC*IREC+1 
C 

C  CHECK  STATUS  OF  BLOCK  READ 

C  IFLG=0  FOR  DATA  BLOCK  READ,  IFLG*1  FOR  END  OF  FILE  READ, 

C  =2  FOR  PROBLEM 

IF(IFLG.EQ.1)THEN 
C 

C  SET  COUNTER  TO  CHECK  FOR  DOUBLE  EOF,  IF  TRUE  STOP 
IE0F*IE0F+1 
IF( I EOF . EQ. 2 )RETURN 
C 

WRITE(6,*)'END  OF  FILE '.IFIL,'  REACHED  AT  BLOCK ',IREC 
IFIL*IFIL+1 
IREC*0 
RETURN 
END  IF 
C 

IE0F*0 

C 

IF(IFLG.EQ.2)THEN 

WRITE (6,*) 'PROBLEM  ENCOUNTERED  WHILE  READING  RECORD \IREC 
STOP 
END  IF 
C 


Q*************** ************* *********************************************** 


ooo  o  o  o  o  o  o  o 


C  BYTE  1:  FRAME  SYNC,  IS  OR  240  FOR  GOOD  DATA;  0  OR  255  FOR  HEADER. 

C  IF  HEADER,  THE  8 -BIT  BYTES  ARE  SPLIT  INTO  4-BIT  BYTES  AND  DECODED, 

C  SEE  CODE  FOR  OECODING  HEADER  BELOW. 

C  DATA  BYTES 

C  BYTE  2:  LEAST  SIGNIFICANT  PRESSURE 

C  BYTE  3:  MOST  SIGNIFICANT  PRESSURE 

C  BYTE  4:  LEAST  SIGNIFICANT  TEMPERATURE 

C  BYTE  5:  MOST  SIGNIFICANT  TEMPERATURE 

C  BYTE  6:  LEAST  SIGNIFICANT  CONDUCTIVITY 

C  BYTE  7:  MOST  SIGNIFICANT  CONDUCTIVITY 

C  BYTE  8:  SIGN  BYTE,  BIT  1  FOR  PRESSURE,  BIT  2  FOR  TEMPERATURE 

C  BYTES  9-12:  TIME  BYTES 
C 

c*************************************************************************** 

c 

C  CHECK  FOR  HEADER  RECORD 

IF ( IBUF(1 ) .EQ.O.OR. IBUF (1 ) .EQ.255 )THEN 

DECODE  HEADER  RECORD:  PRES  CODE,  TYPE  CAST,  JUL.  DAY,  STATION,  CRUISE  NO 

CALL  BYTE2(IBUF(2),IL,IR) 

IPCODE=IL 
ITCAST=IR 

CALL  BYTE2(IBUF(3),IL,IR) 

CALL  BYTE2 ( IBUF(4 ) , IL 1 , IR1 ) 

JDAY=IR1*100  +  IL*10  +  IR 

CALL  BYTE2(IBUF(5),IL, IR) 

ISTA=IL*100  +  IR*10  +  IL1 

CALL  BYTE2(IBUF(6),IL,IR) 

CALL  BYTE2 ( IBUF (7 ) , IL1 , IR1 ) 

CALL  BYTE2(IBUF(8) ,IL2, IR2) 

ICRUIS=IL2*10**5+IR2*10**4+IL1*1000-HR1*100+IL*10+IR 
WRITE (6 , * ) 

WRITE(6,*) '  TAPE  HEADER  CONTENTS’ 

WRITE(6,*) 1  (PCODE,  TYPE  CAST,  DAY,  STATION,  CRUISE)' 

WRITE (6 , * ) I PCODE , ITCAST , JDAY , I STA , ICRUIS 
GO  TO  10 
ELSE 


WRITE (6,*) (IBUF (I ),I=1,12) 

L*0 

DO  200  J =1,2040, 12 
L=L+1 

C  GET  PRESSURE  SIGN 
IPS*1 

IF(IBUF(J+7).EQ.1.0R.IBUF(U+7).EQ.3)IPS*-1 
C  GET  TEMPERATURE  SIGN 


IF(IBUF(J+7).EQ.2.0R.IBUF(J+7).EQ.3)ITS«-1 
C  CALCULATE  PRES,  TEMP,  AND  COND 

PP (L )*IPS*{ IBUF (J  +2 )*IM  +  IBUF(J+1 ))/10. 

TT  {L )  *1 TS* ( IBUF ( J  +4 ) *IM  +  IBUF(J+3))/2000. 
CC(L)“(IBUF{J+6)*IM  ♦  IBUF(J+5))/1000. 

C  CALCULATE  TIME 

C  FIRST  REVERSE  BITS  IN  EACH  TIME  BYTE 
CALL  REVBIT(IBUF (J+8) ,IREV9) 

CALL  REVB IT ( IBUF ( J  +9 ) , IREVIO ) 

CALL  REVBITf IBUF (J+10) , I RE VI 1 ) 

CALL  REVB IT(IBUF(J+11),IREV12) 

C  ADD  BYTES  TOGETHER 
LCT-LCT+1 

HH (L )* ( I RE V12*IM**3  ♦  IREV11*IM**2  +  IREV10*IM  ♦  IREV9)/1000 
CM  WRITE (6,*) 'HH,PP,TT,CC,L' ,HH(L) ,PP{L),TT(L),CC(L),L 
200  CONTINUE 
C 

END  IF 
C 

RETURN 

END 


,v^. 
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oooooo  r>  oo  ooooo  o  ooooooo 


SUBROUTINE  ZWRITJJU, IF.IBL) 

THIS  SUBROUTINE  IS  THE  WRITE  HALF  OF  AN  INPUT-OUTPUT 
PACKAGE  FOR  HANDLING  NON -FORMATTED,  ASCII  FORTRAN 
WRITTEN  DATA  FILES,  COMMONLY  REFERRED  TO  AS 
FEB  (FAST  A  EASY  8 INARY)  FILES. 


IMPLICIT  REALM  (A-H.O-Z) 

IMPLICIT  INTEGERS  (I,J,K,L,M,N) 

CHARACTERS  ADOCR , IPR ,NMFR ,NMBR,PNR,RNR 
CHARACTE  R*6  AOOCW , I PW , NMFW , NMBW , P  NW , R  NW 
COMMON  /  WHDR  /LW.NW.NBW.NFW.NIW.NAW 
COMMON  /  WHDR1  /NMBW,NMFW,PNW,RNW,IPW(1) 

COMMON  /WDOCF/FOOCW ( 1 )  /WDOCI/IDOCWU)  /WD0CA/AD0CW(1 ) 

COMMON  /  WDATA  /  VW(1) 

NOTE:  ORIGINAL  ZREAD  CONSISTED  OF  RHDR  AND  WHDR  COMMONS  ALONE, 
ASCII  FORTRAN  REQUIRED  PLACING  CHARACTER  VARIABLES  IN 
SEPARATE  COMMONS  -  RHDR1  AND  WHDR1. 

COMMON  /RHDR  /LR,NR,NBR,NFR,NIR,NAR 
COMMON  /RHDR1  /NMBR,NMFR,PNR,RNR, IPR (1 ) 

COMMON  /RDOCF/FDOCR(l)  /RDOCI/IDOCR(l )  /RDOCA/ADOCR(l ) 

COfflON  /  RDATA  /  VR(1) 


COMMON  /  DIAGS  /  MSGR , MSGW , NNNR , NNNW , NN IP , NNF , NN I , NNA , IRST , IWST 
LOGICAL  B1,B210,B10,B35,B45,B69,0D 
COMMON  /  JPOS  /  JUNIT(99) 

COWON  /DRDCOM/  JFLG,ISECR(99) 

DIMENSION  IUNIT (99 ) 

DATA  MSGW  /  2  / 

DATA  LLSW  /  1  /,  IRST,  IWST  /  1,  1  / 

DATA  IBUF/600/ 

IW*1 

IF(JU.LT.O)  IW»2 
IU-ABS(JU) 

OPEN  DIRECT  ACCESS  FEB  FILES  AS  REQUIRED. 

RECORD  SIZE  IS  SET  TO  IBUF  IN  DATA  STATEMENT. 

EACH  HOLLERITH  WORD  CONSISTS  OF  SIX  CHARACTERS, 

AND  THUS  OCCUPIES  ONE  AND  ONE -HALF  WORDS. 

IF( I U . NE . IUSAV )THEN 
INQUIRE (UNIT*IU,OPENED»OD) 

IF(.NOT.OD)  OPEN(UNIT«IU, ACCESS- 'DIRECT', FORM-' UNFORMATTED ’ , 

«  STATUS* 'UNKNOWN ' ,ERR*9090,RECL*IBUF) 

IUSAV-IU 
END  IF 


k 


BlsMSGW.EQ.l 

B210-MSGW . 6E . 2. AND . MSGW . LE . 10 
B10*MSGW.EQ.10 

B35-MSGW.EQ.3.0R.MSGW.EQ.5.0R.MSGW.EQ.7.0R.MSGW.EQ.9.0R.MSGW.EQ.10 
B45=MSGW.EQ.4.0R.MSGW.EQ.5.0R.MSGW.6E.8.AND.MSGW.LE.10 
B69-MSGW . GE . 6 . AMD . MSGW . LE . 9 
C 

IBLK-IBl 

IP0S*JUNIT(IU) 

IREC-ISECR(IU) 

IF(IPOS.EQ.O)  IP0S=1 
IF(IREC.EQ.O)  IREC*1 
IF(IBL.EQ.O)  IBLK*IUNIT(IU) 

IF(IBLK.LT. IPOS)  GO  TO  5 
4  IFOBLK.EQ. IPOS)  GO  TO  3 
C 

C  FULL  DUMMY  READ  IS  REQUIRED  IN  ORDER  TO  VERIFY  RECORD. 

C  FILES  ARE  ZERO-FILLED  IN  INITIAIZATION  ON  THE  UNIVAC, 

C  BUT  ARE  NOT  ON  THE  VAX  -  ERR=99  BRANCH  IS  USED. 

READ(IU 'IREC, ERR=99)LQ,NQ,NFQ,NIQ, NAQ, NBQ, (NMBQ, I«l,LQ+4), 

A(FDOCQ, 1=1 , NFQ) , ( IDOCQ, 1*1 , NIQ ) . (NMBQ, 1=1 , NAQ) , 
A(VQ,M=((IRST-1)*LQ+1),(IRST-1)*LQ+IBUF 
A-(10+LQ+NFQ+NIQ+NAQ+(5+LQ+NAQ)/2 ) ) 
IF(LQ.EQ.O.OR.NBQ.EQ.O.OR.NFQ.LT.O.OR.NIQ.LT.O.OR.NAQ.LT.O) 

AGO  TO  99 

C  IUORDS  IS  THE  TOTAL  WORDS  CONTAINED  IN  THE  SEGMENT 
IWORDS* (10+LQ+NFQ+NIQ4NAQ+ (5+LQ4NAQ )/2 )+ (LQ*NQ ) 

C  IREC  IS  THE  RECORD  NO.  FOR  THE  NEXT  SEGMENT 
IREC=( (IW0RDS-1)/IBUF)+1+IREC 
IP0S=IP0S+1 
IUNIT(IU)=IPOS 
JUNIT(IU)=IPOS 
GO  TO  4 
C 

5  IREC=1 

IP0S=1 
ISECR(IU)=0 
IUNIT(IU)=IPOS 
JUNIT(IU)=IPOS 
IF  (IBL.NE.O)  GO  TO  4 
C 

C  FIND  RECORD  NO.  FOR  WRITE  AT  END  OF  FILE,  IBL-0 
2  READ(IU 'IREC, ERR*6)LQ,NQ, NFQ, NIQ, NAQ.NBQ, (NMBQ, 1=1, LQ+4), 

A(FDOCQ, 1=1, NFQ), (IDOCQ, 1=1, NIQ), (NMBQ, 1=1, NAQ), 

S(VQ,M={ (IRST-1)*LQ+1) , (IRST-1 )*LQ+IBUF 
A-  ( 1 0+LQ-H4F  Q+N I Q+N AQ+ ( 5  +L  Q+N AQ ) /2 ) ) 
IF(LQ.EQ.O.OR.NBQ.EQ.O.OR.NFQ.LT.O.OR.NIQ.LT.O.OR.NAQ.LT.O) 

AGO  TO  6 

I WORDS* ( 10+LQ+NFQ+N IQ+NAQ+ ( 5+LQ+N AQ ) /2 )+{LQ*NQ ) 

IREC* ( ( IWORDS-1 ) /IBUF )+l+IREC 
IPOS-IPOS+1 
IUNIT(IU)*IPOS 
JUNIT(IU)*IPOS 
C2 
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GO  TO  2 

6  CONTINUE 
WRITE (6, 1001 )IU 


3  CONTINUE 
NBW*IPOS 

GO  TO  (81,82),IW 

81  IF(NW.GT.NNNW.OR.LW.GT.NNIP.OR.NFW.GT.NNF. 

*  OR.NIW.GT.NNI.OR.NAW.GT.NNA)  GO  TO  95 

M1={IWST-1 )*LW+1 

M2=IBUF - ( 10+LW+NFW+N IW+NAW+ ( 5+LW+NAW ) /2 )+Ml -1 

NL=NW*LW 
N1*(IWST-1 )*LW+1 
N2=N1+NL-1 
IF(M2.GT.N2)M2=N2 

WRITE ( I U ' I REC , ERR=97 )LW , NW , NFW , N I W , NAW , NBW , NMBW , NHFW , 
*PNW,RNW, (IPW(I) ,I=1,LW) , (FDOCW(J ) ,J=1,NFW) , 

*(IDOCW(K ) ,K=1 ,NIW) , ( ADOCW(L ) ,L*1,NAW) , 

*(VW(M),M*M1,M2) 

IF(JFLG.NE.l)  GO  TO  70 

I WORDS* ( 10+LW+NFW+N IW4NAW+(5+LW+NAW) /2 )♦ (LW*NW ) 

IREC  IS  THE  RECORD  NO.  FOR  THE  LAST  RECORD  IN  THIS  SEGMENT 
IREC=( (IWORDS-1 )/IBUF)+IREC 
GO  TO  83 

D  IF(M2.EQ.N2)G0  TO  83 

M1*M2+1 
M2*M2+IBUF 
IF(M2.GT.N2)M2=N2 
IREC*IREC+1 

WRITE  ( IU '  IREC , ERR*97 )  ( YW ( J  } , J  *M1 ,M2 ) 

GO  TO  70 

2  Ml=*  ( IRST — 1  )*LR+1 

M2=I BUF- ( 10+LR+NFR+N I R+NAR+ ( 5+LR+NAR ) /2 )+Ml -1 

NL=NR*LR 
N1*(IRST-1 )*LR+1 
N2=N1+NL-1 
IF(M2.GT.N2)M2=N2 

WRITE (IU' IREC, ERR*97)LR, NR, NFR,NIR,NAR, NBW, NMBR,NMFR, 
*PNR,RNR, (IPR{I ) ,I*1,LR) , (FOOCR (J ) ,J*1,NFR) , 

*(IDOCR(K ) ,K*1 ,NIR) ,(ADOCR(L ) ,L*1 ,NAR) , 

*(VR(M),M*M1,M2) 

IF(JFLG.NE.l)  GO  TO  71 

IWORDS*  ( 10+LR+NFR+N IR+NAR+(5+LR*NAR )  /2 )+  (LR*NR ) 

IREC  IS  THE  RECORD  NO.  FOR  THE  LAST  RECORD  IN  THIS  SEGMENT 


V- 

fC 


| 

I 


g 

Si 


vv.v.v;.- 


IREC*( (IWORDS-1 )/IBUF)+IREC 
GO  TO  83 

L  IF(M2.EQ.N2)G0  TO  83 
H1-M2+1 
M2-M2+IBUF 
IF(M2.GT.N2)M2=N2 
IREC*IREC+1 

WRITE ( IU ’ IREC , ERR=97 ) ( VR  (J  ) , J»M1  ,M2 ) 
GO  TO  71 

83  CONTINUE 


IPOS-IPOS+1 
ISECR(IU)*IREC+1 
IUNIT(IU)*IPOS 
JUNIT(IU)*IPOS 
GO  TO  (84,85) ,IW 

84  IF ( B210 )  WRITE(6,1000)IU,NHFW,NBW,NMBW,PNW,RNW,NW,LW,NFW,NIW,NAW 
1000  FORMAT ( '  WRITE  UNIT', 13,';  FILE  '  A6, 

*  SEGNUM' ,14, ' ;  SEGNAM  ',A6,r;  PN-',A6,';  RN=\A6, 

*  *;  N*'  ,16, ' ;  L='  ,14, '  NF-'.IA,'  NI«',I4,'  NA»\I4) 

% 

* 

% 

IF(B1)  WRITE (6,1011)  IU,NMFW,NBW,NM8W,PNW,RNW,NW,LW,NFW,NIW,NAW 
1011  FORMAT ( '  WRT  ',I4,2X,A6,2X,I4,2X,3(A6»2X), 16,414) 

IF ( B35 )  WRITE(6,1012)(IPW(I ),I*1,LW) 

1012F0RMATC  PARAMETERS:  '12(2X,A6)/(13X,12(2X,A6))) 

IF(.N0T.B45)  GO  TO  110 

IF( (NFW+NIW+NAW) .EQ.O)  GO  TO  110 

WRITE (6, 1013) 

1013  FORMAT ( '  ADDL  DATA: ' ) 

I F ( NFW .GT . 0 )WRITE (6,1 100 ) ( FDOCW ( I ) ,I*1,NFW) 

IF(NIW.GT.O) WRITE (6,1101 ) (IDOCW(I ) ,I31,NIW) 

IF(NAW.GT.0)WRITE(6, 1102) (ADOCW( I ) ,1*1 ,NAW) 

1100  F0RMAT(10(G11.5)) 

1101  F0RMAT(1X,12I6) 

1102  FORMAT (1X.12A6) 

* 

"  110  IF ( .N0T.B69)  GO  TO  107 
JLaIWST*LW 
Jl-JL-LW+1 

WRITE(6,1014)(VW(I),I*J1,JL) 

JL=(NW+IWST-1 )*LW 
Jl-JL+l-LW 

WRITE(6,1015)(VW(J ),J*J1,JL) 

1014  FORMAT ( '  FIRST  CYCLE: * , 10 (G1 1 .5 )/ (13X, 10 (G1 1 . 5 ) ) ) 

1015  FORMAT ( '  LAST  CYCLE:  ', 10(611. 5)/(13X,10(Gll. 5))) 

C 

107  IF( .NOT. BIO)  GO  TO  108 
WRITE(6,1017) 

IQ1-IWST 


v: 


KM? 


J.vy. 


1 


. 


IQ2aIQl+NW-l 
00  106  IaIQl,IQ2 
JLaI*LW 
J1*JL+1-LW 

WRITE (6, 1016)  MVWUJ.J-Jl.JL) 
106  CONTINUE 

1016  F0RHAT(5X,I5,3X,10G12.6) 

1017  FORMAT ( // '  LISTING  OF  DATA'///) 


C 


C 

C 

C 


GO  TO  86 

85  IF(B210)  WRITE(6,1000)IU,NMFR,NBW,NMBR,PNR,RNR,NR,LR,NFR,NIR,NAR 
IF(B1)  WRITE (6,1011 )  IU,NMFR,NBW,NMBR,PNR,RNR,NR,LR,NFR,NIR,NAR 
IF{ B35 )  WRITE (6,1012 )  ( IPR  (I ) , Ial , LR ) 


C 


C 


C 

C 


IF( .N0T.B45)  GO  TO  109 

IF( (NFR+NIR+NAR).EQ.O)  GO  TO  109 

WRITE (6, 1013) 

IF(NFR.GT.0)WRITE(6, 1100)(F00CR(I ),Ial,NFR) 
I F(NIR.GT.O) WRITE (6,1101 ) (IDOCR(I ) ,Ial,NIR) 
IF (NAR.GT.O) WRITE (6,1102 ) (AOOCR(I ) ,Ial ,NAR) 

109  IF ( .N0T.B69)  GO  TO  117 
JLaIRST*LR 
JlsJL+1-LR 

WRITE(6,1014)(VR(I),W1,JL) 

JL= (NR+IRST-1 )*LR 
J1=0L+1-LR 

WRITE (6,1015)(VR(J  ),J=J1,JL) 

117  IF ( .NOT. BIO)  GO  TO  108 
WRITE(6,1017) 

IQ1=IRST 
IQ2=IQ1+NR-1 
DO  116  IaIQl, IQ2 
JLaI*LR 
J1=JL+1-LR 

WRITE(6,1016)  I,(VR (J ),J=J1,JL) 

116  CONTINUE 


86  CONTINUE 
108  IF=0 
IUPaIU 
RETURN 


C 

C 


S95  IF a5 

WRITE (6 , 1005 )NNNW , NN I P , NNF , NN I , NNA , 

*  NW , LW , NFW , N I W , NAW 

1005  FORMAT (//'  A  DIMENSION  IS  TOO  SMALL.'// 

*  '  NNNWa' ,16, '  NNIP* * ,16, 1  NNFa',I6, 

»  *  '  NNIa' ,16, 1  NNAa' ,16//'  NWa',I6, 
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I 


LWa‘ ,16, 1 


NFW»',I6,‘  NIWS* ,16, '  NAWS' ,16//) 


RETURN 
97  IF-3 

WRITE (6 ,1003)  IU 

1003  FORMAT ( '  WRITE  ERROR  ON  UNIT  *,13) 

LU*IU 
GO  TO  90 
99  IF*1 

WRITE (6, 1001)  IU 
1001  FORMAT ( 1  EOF  ON  UNIT  ',13) 

LU=IU 
GO  TO  90 
C 

ENTRY  RESETW(KU) 

LU=KU 

CLOSE (UNITaLU) 

IUSAV*0 

90  IREC=1 
IP0S=0 
IUNIT(LU)=0 
JUNIT(LU)*0 
ISECR(LU)=0 
RETURN 

9090  WRITE(6,*)  '  ERROR  IN  OPENING  UNIT  ’,IU 
END 
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Appendix  B:  A  program  for  completing 
FEB  file  headers 


A  PROGRAM  FOR  COMPLETING  FEB  FILE  HEADERS 


The  purpose  of  the  program  HEDFIL  Is  to  fill  the  header  common  areas  of  FEB 
files.  This  program  Is  written  entirely  In  FORTRAN  77.  FEB  utility  subroutines 
ZREAD  and  ZWRIT  are  required.  A  brief  description  follows.  The  input  FEB 
file  Is  assigned  to  logical  unit  3.  All  updates  to  the  FEB  file  headers  are  made 
with  direct-access  writes  to  this  file.  It  Is  a  good  idea  to  have  a  backup  copy 
of  the  Input  file  In  case  of  user  error  while  using  this  program.  Input  to  the 
program  Is  given  by  instruction  file  which  consists  of  a  one-letter  key  ($,  F,  I, 
A,  S,  or  E)  followed  by  the  associated  Input.  Instruction  file  Input  is  described 
below. 

$  Text  string  Comment  statement  used  for  documentation,  no  effect  on 

the  processing. 

F  J ,K,(FD0C( I ) ,  I=J ,K)  FDOC  words  from  word  no.  J  through  word  no.  K. 

I  J,K,(ID0C(I) ,I=J,K)  I DOC  words  from  word  no.  J  through  word  no.  K. 

A  J ,K,( AD0C( I ) ,I=J ,K)  ADOC  words  from  word  no.  J  through  word  no.  K.  A 

maximum  of  12  six-character  words  per  line  may  be 
Input. 

S  ISEG  Reads  the  header  for  segment  no.  ISEG  Into  core  and 

writes  all  headers  through  segment  no.  ISEG-1. 

E  Remainder  of  segment  headers  are  written. 

Note:  No  additional  header  words  can  be  added  with  this  program.  All  changes 
remain  in  effect  through  the  end  of  the  data  set  {i.e.,  IDOCC 1)=1) . 

Sample  UNI VAC  Run: 

0MAP,I  A 
IN  .HEDFIL 
IN  .ZREAD 
IN  .ZWRIT 
0END 

0ASG.A  FEBFILE. 

0USE  3., FEBFILE. 

0XQT  A 

$  INSERT  FDOC(l)  -  FD0C(3) 

F  1,3,11. ,22. ,33. 

$  INSERT  I00C(2)  -  ID0C(4) 

I  2,4,10,20,30 


$  INSERT  FD0C(8) 

F  8,8,44.3 

$  INSERT  ADOC(l)  -  ADOC{2) 

A  1,2, TEST  CASE  12 
$  INSERT  ADOC(13)  -  AD0CU6) 

A  13, 24, THIS  IS  A  TEST  LINE. 

$  INSERT  I DOC ( 9 )  -  IDOC(IO) 

I  9,10,100,200 

$  GET  FIRST  SEGMENT  OF  NEXT  DATA  SERIES 
S  21 


o  o  o  o 


PROGRAM  LISTING 


g****************************************************** *********************** 

PROGRAM:  HEDFIL 

THIS  PROGRAM  FILLS  THE  FEB  COMMON  AREAS 

Q-k-k-k'kii-kii-k-k-k-kltitlt-kltitititlf-k-klrlt-k-k'k-kltltlrlc-k-k'kltlclcklfklckltlrklrkltlrklrklrlrkitifklrklrklrlrtckltlr-irk-kltl'1'lrk 

c 

IMPLICIT  REAL *4  (A-H.O-Z) 

IMPLICIT  INTEGERS  ( I,J,K,L,M,N) 

C 

CHARACTERS  A 
CHARACTERS  IN 

CHARACTERS  ADOCR , I PR , NMFR , NMBR ,  PNR , RNR , AD 
C 

C  ZREAD  COMMON  AREAS 

COMMON  /RHDR  /LR,NR,NBR,NFR,NIR,NAR 
COMMON  /RHDR1  /NMBR, NMFR, PNR, RNR, IPR(4) 

COMMON  /RDOCF /FDOCR ( 500 )  /RD0CI/ID0CR{500)  /RDOCA/ ADOCR (500) 

COMMON  /  RDATA  /  VR (20000) 

C 

COMMON  /  DIAGS  /  MSGR ,MSGW , NNNR , NNNW , NN I P , NNF , NN I , NNA , IRST , IWST 
C 

COMMON  /DRDCOM/  JFLG 
C 

DIMENSION  FD (2 , 500 ) , ID (2 , 500 ) ,A0(500 ) ,ADF( 500 ) 

C 

DATA  NNNR, NNNW, NNIP, NNF, NNI, NNA  /1000, 1000,4,500,500,500/ 

DATA  IU, IOU, ISEG,K  /3,-3,l,0/ 

C  SET  FLAG  FOR  DIRECT  ACCESS  HEADER  WRITE  ONLY 
JFLG*1 
C 

0****************************************************************** 

WRITE(6,*) 'HEDFIL:  A  FEB  HEADER  FILL  PROGRAM' 

g****************************************************************** 

C 

C  READ  SEGMENT  1  INTO  CORE 
CALL  ZREAD (3, IF, 1) 

IF(IF.GE.1)THEN 

WRITE(6,*) 'PROBLEM  WITH  INPUT  FILE’ 

STOP 
END  IF 
C 

WRITE(6,*) 'ENTER  INSTRUCTIONS' 

C 

g ****★***★*****★**************★***★★**★***•*****★+**★*****★************* 

C 

C  OPEN  SCRATCH  FILE  TO  ALLOW  LIST  DIRECTED  READ 
CLOSE (UNIT *29) 

0PEN(UNIT*29, STATUS* 'SCRATCH ' ,ERR*9096 ) 

C 

C  READ  INPUT  INTO  INTERNAL  FILE 
1 0  READ ( 5 , 5000 , ERR  *9000 , END  *999 ) I N 


V 


5000  FORMAT (A) 

C  WRITE  INSTRUCTION  TO  UNIT  29 
WRITE (29, 5000 )IN (3: 74) 

BACKSPACE  29 
C 

Q******** ************************************************************* 

c 

C  TRANSLATE  INSTRUCTION 
A=IN(1:1) 

C 

Q********************************************************************** 

c 

C  READ  COMMENT 

IF(A(1: 1).EQ. '$' .0R.A(1: 1).EQ. '$' )G0  TO  10 
C 

Q********************************************************************** 

C 

C  SET  UP  INSTRUCTIONS  TO  COMPLETE  WRITING  OF  FEB  FILE 
GO  TO  20 

999  IN (3:9)= '999999  ' 

WRITE (29, 5000) IN (3: 9) 

BACKSPACE  29 
A='S' 

20  CONTINUE 
C 

Q************************************************************************* 

c 

C  READ  SEGMENT  NO.  AND  WRITE  SEGMENTS  UP  TO  SEGMENT  NO. 

IF(A.EQ. 'S' .OR.A.EQ. ' s' )THEN 
READ(29,*,ERR=9097)ISEG 

C  IF  I SEG  IS  1,  THIS  SEGMENT  HAS  ALREADY  BEEN  READ 
IF(ISEG.EQ.1)G0  TO  10 
K=K+1 


IF(K.GT. ISEG)THEN 

WRITE (6,*) 'SEGMENT  MUST  BE  GREATER  THAN  LAST  SEGMENT  READ' 
STOP 
END  IF 

DO  40  I=K, ISEG-1 


INCORPORATE  CHANGES 
IF(JFD.EQ.l )THEN 
DO  32  J=1,NFR 

IF(FD(2,J  ).GT.0. 5)FD0CR(J  )=FD(1 ,J ) 
END  IF 

IF(JID.EQ.1)THEN 
DO  34  J=1,NIR 

IF(ID(2 ,J ) . EQ . 1)1 DOCR ( J )=ID(1 ,J ) 
END  IF 


IF(JAD.EQ.1)THEN 
DO  36  J*1,NAR 


w 


r 


36  IF(ADF(J).GT.0.5)AD0CR(J)*AD(J) 

ENO  IF 

C 

I$W*NBR 

CALL  ZWRIT(IOU,IF,ISW) 

IF(IF.GT.l)STOP 

C  RESET  FLAGS  AT  END  OF  SERIES 
IF(IDOCR(l).EQ.l )THEN 
DO  37  J*1,NFR 

37  FD(2,J)aO. 

DO  38  Jal,NIR 

38  ID<2,J)aO 

DO  39  Jal,NAR 

39  ADF(J )=0. 

JFD=0 
JID=0 
JAD=0 
END  IF 

C 

CALL  ZREAD(IU,IF,0) 

IF(IF.EQ.1)THEN 

WRITE(6,*) 'EOF  REACHED  IN  INPUT  FILE' 

STOP 
END  IF 
C 

40  CONTINUE 
C 

KaISEG 
GO  TO  10 
END  IF 
C 

Q********************************************************************* 

c 

C  WRITE  REST  OF  FEB  FILE 

IF(A.EQ.'E'.OR.A.EQ.'e')GO  TO  999 
C 

£*****★★*★******★***★*★★★★**★★★★*★****★*★****★*★*********★★★*★*★***★*** 

c 

C  READ  FDOC  INSTRUCTION 

IF(A.EQ.'F'.OR.A.EQ.'f' )THEN 
READ(29,*,ERR=9097)I1,I2 
C 

IFdl.LE.O.OR.  Il.GT.  I2)THEN 

WRITE{6,*) 'INDEX  IS  LESS  THAN  0  OR  1ST  INDEX  IS  GREATER 
*  'THAN  2ND' 

STOP 
END  IF 
C 

IFd2.GT.NFR)THEN 

WRITE (6,*) 'INDEX  IS  GREATER  THAN  MAX  INDEX  ALLOWED,  NFRa',NFR 
STOP 
END  IF 


C 


BACKSPACE  29 
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C 


READ (29,*, ERR “9097)11, I2,(FD(1,I),I*I1,I2) 
DO  42  1-11,12 
FD(2,I)*1 
JFD-1 
GO  TO  10 
END  IF 


c*************************************************************************** 

c 

C  READ  I DOC  INSTRUCTION 

IF(A.EQ. 'I ' .OR.A.EQ. ' 1 1 )THEN 
READ (29,*,ERR*9097)I 1,12 
C 

IF( Il.LE.O.OR. Il.GT. I2)THEN 

WRITE(6,*) 'INDEX  IS  LESS  THAN  0  OR  1ST  INDEX  IS  GREATER  ', 

*  'THAN  2ND' 

STOP 
END  IF 
C 

IF ( 1 2. GT . NIR )THEN 

WRITE(6,*) 'INDEX  IS  GREATER  THAN  MAX  INDEX  ALLOWED,  NIR-', NIR 
STOP 
END  IF 
C 

BACKSPACE  29 

READ (29, *,ERR*9097)I 1,12,(10(1,1), 1*11, 12) 

DO  44  1*11,12 
44  ID(2,I)*1 

JID=1 


GO  TO  10 
END  IF 


c 

C  READ  ADOC  INSTRUCTION 

IF(A.EQ.'A'.OR.A.EQ.'a')THEN 
READ(29,*, ERR *9097)11, 12 
C 

IF ( II. LE - 0 . OR .11. GT - I2)THEN 

WRITE (6,*) 'INDEX  IS  LESS  THAN  0  OR  1ST  INDEX  IS  GREATER  ’, 

*  'THAN  2ND ' 

STOP 
END  IF 
C 

IF(I2.GT.NAR)THEN 

WRITE (6,*) 'INDEX  IS  GREATER  THAN  MAX  INDEX  ALLOWED,  NAR*',NAR 
STOP 
END  IF 


C 

C 


THERE  CAN  BE  NO  MORE  THAN  12  ADOC  WORDS  PER  LINE 
IF(I2-I1+1.GT.12)THEN 

WRITE (6,*) 'TOO  MANY  ADOC  WORDS  -  ONLY  12/LINE  ALLOWED' 
WRITE (6,*) 'TRY  AGAIN' 

GO  TO  10 


SvC 


& 


40 


c 

C  FIND  START  OF  ADOC  TEXT 
IC0M=0 

DO  50  1=1,12 
I CHAR2 I 

IF ( I N ( I : I ) .EQ. ' , ' )IC0M=IC0M+1 
IF(IC0H.EQ.2)G0  TO  51 

50  CONTINUE 

51  CONTINUE 
C 

IC1*ICHAR+1 

IC2=(I2-I1+1)*6+ICHAR 

C 

JW=I1 

DO  60  I=IC1,IC2,6 
AD(JW)=IN(I:I+5) 

60  JW=JW+1 

C 

DO  46  1*11,12 
46  ADF(I )*1 

JAD=1 
GO  TO  10 
END  IF 
C 

Q******* **************************************************** *********** 

c 

9000  WRITE (6,*) 'ERROR  IN  READING  INSTRUCTION,  TRY  AGAIN1 
GO  TO  10 

9096  WRITE (6,*) 'ERROR  IN  OPENING  UNIT  29,  DO  NOT  USE  UNIT  29!' 

STOP 

9097  WRITE(6,*) 'ERROR  WHILE  READING  INSTRUCTION  '.A,'  TRY  AGAIN' 

GO  TO  10 

END 
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SUBROUTINE  ZREAD(IU,IF,IBL) 

THIS  SUBROUTINE  IS  THE  READ  HALF  OF  AN  INPUT-OUTPUT 
PACKAGE  FOR  HANDLING  NON -FORMATTED,  ASCII  FORTRAN 
WRITTEN  DATA  FILES,  COMMONLY  REFERRED  TO  AS 
FEB  (FAST  A  EASY  BINARY)  FILES. 


IMPLICIT  REALM  (A-H.O-Z) 

IMPLICIT  INTEGERS  (I,J,K,L,M,N) 

CHARACTERS  ADOCR , IPR , NMFR , NMBR ,PNR , RNR 
COMMON  /RHDR  /LR,NR,NBR,NFR,NIR,NAR 
COMMON  /RHDR1  /NMBR, NMFR, PNR, RNR, IPR (1 ) 

NOTE:  ORIGINAL  ZREAD  CONSISTED  OF  RHDR  COMMON  ALONE, 

ASCII  FORTRAN  REQUIRED  PLACING  CHARACTER  VARIABLES  IN 
SEPARATE  COMMON  -  RHDR1. 

COMMON  /RDOCF/FDOCRU)  /RDOCI/IDOCR(l )  /RDOCA/ADOCRU ) 

COMMON  /  RDATA  /  VR(1) 

COMMON  /  DIAGS  /  MSGR , MSGW , NNNR , NNNW , NN I P , NNF , NN I , NNA , IRST , IWST 
COMMON  /  JPOS  /  JUNIT (99 ) 

COMMON /DRDCOM/  JFLG, ISECR (99 ) 

DIMENSION  IUNIT (99 ) 

LOGICAL  B1,B210,B10,B35,B45,B69,0D 
DATA  MSGR  /  2  / 

DATA  LLSW/1/,  IRST/1/ 

DATA  IBUF/600/ 

Bl-MSGR.EQ.l 

B210=MSGR.GE .2. AND .MSGR .LE . 10 
B10=MSGR.EQ.10 

B35*MSGR.EQ.3.0R.MSGR.EQ.5.0R.MSGR.EQ.7.0R.M$GR.EQ.9.0R.MSGR.EQ.10 
B45=MSGR.EQ.4.0R.MSGR.EQ.5.0R.MSGR.GE.8.AND.MSGR.LE.10 
B69=MSGR . GE . 6 .AND .MSGR . LE . 9 


OPEN  DIRECT  ACCESS  FEB  FILES  AS  REQUIRED. 

RECORD  SIZE  IS  SET  TO  IBUF  IN  DATA  STATEMENT. 

EACH  HOLLERITH  WORD  CONSISTS  OF  SIX  CHARACTERS, 

AND  THUS  OCCUPIES  ONE  AND  ONE -HALF  WORDS. 

IF ( IU . NE . IUSAV )THEN 
INQUIRE (UNIT-IU.OPENEO-OD ) 

IF(.NOT.OD)  OPEN (UNIT*IU, ACCESS*'DIRECT' , FORM*1 UNFORMATTED' , 
*  STATUS* ' UNKNOWN ' , ERR*9090 , RECL  *IBUF ) 

IUSAV*IU 
END  IF 
C 
C 

IBLK-IBL 

IPOS*JUNIT(IU) 

IREC-ISECR(IU) 

IF ( IPOS.EQ.O )  IPOS-1 
IF(IREC.EQ.0)IREC*1 


oouo  o  o  u  ouu 


c 


Cl 


C 

C 


IF(IBL.EQ.O)  IBLK*IUNIT(IU) 

IF(IBLK.LT.IPOS)  GO  TO  5 

4  IF( IBLK.EQ. IPOS)  GO  TO  3 

FULL  DUMMY  READ  IS  REQUIRED  IN  ORDER  TO  VERIFY  RECORD. 
FILES  ARE  ZERO-FILLED  IN  INITIAIZAT10N  ON  THE  UNI VAC, 

BUT  ARE  NOT  ON  THE  VAX  -  ERR-99  BRANCH  IS  USED. 

READ (IU'IREC,ERRS99)LQ,NQ,NFQ,NIQ,NAQ,NBQ((NMBQ, 1*1, LQ+2), 
*(FDOCQ,I=l,NFQ),(IDOCQ,I*l,NIQ),(NMBQ,I*l,NAQ), 

*(VQ,M= ( ( IRST-1 )*LQ+1 ) , (IRST-1 )*LQ+IBUF 
*-(10+LQ+NFQ+NIQ+NAQ+(5+LQ+NAQ)/2}) 
IF(LQ.EQ.O.OR.NBQ.EQ.O.OR.NFQ.LT.O.OR.NIQ.LT.O.OR.NAQ.LT.O) 
*GO  TO  99 

I WORDS  IS  THE  TOTAL  WORDS  CONTAINED  IN  THE  SEGMENT 
IWORDS* (10+LQ+NFQ+NIQ+NAQ+(5+LQ+NAQ )/2 )+(LQ*NQ ) 

IREC  IS  THE  RECORD  NO.  FOR  THE  NEXT  SEGMENT 
IREC* ( ( IWORDS-1 ) /IBUF )+l+IREC 
IPOS=IPOS+l 
IUNIT(IU)=IPOS 
JUNIT(IU)*IPOS 
GO  TO  4 

5  IF*0 
IREC=1 

IF(IBL.EQ.O)  IBLK=1 
IPOS*l 

IUNIT(IU)=IPOS 
JUNIT(IU)=IPOS 
ISECR ( I U )=0 
GO  TO  4 
3  CONTINUE 

THIS  DUMMY  READ  IS  NECESSARY  FOR  END  OF  FILE  CHECKING, 
OTHERWISE,  ARRAY  LIMITS  CAN  EASILY  BE  EXCEEDED. 

READ (IU1 IREC, ERR *99 )LQ,NQ,NFQ,NIQ,NAQ,NBQ,(NMBQ, 1*1, LQ+2), 
*(FDOCQ,I*l,NFQ) ,(IDOCQ,I*l,NIQ) , (NMBQ,I*1,NAQ) , 

*(VQ,M=(( IRST-1  )*LQ+1 ) ,  { IRST-1  KQ+IBUF 
*- ( 10+LQ+NFQ+N IQ+NAQ+ ( 5+LQ+NAQ ) /2 ) ) 
IF(LQ.EQ.O.OR.NBQ.EQ.O.OR.NFQ.LT.O.OR.NIQ.LT.O.OR.NAQ.LT.O) 
*GO  TO  99 

Ml* ( IRST-1 )*LQ+1 

M2*(IR$T-1 )*LQ+IBUF-(10+LQ*NFQ+NIQ+NAQ+(5+LQ+NAQ)/2) 

NL-NQ*LQ 

N2-M1+NL-1 

IF(M2.GT.N2)M2*N2 


READ(IU 'IREC,ERR*99 )LR,NR,NFR,NIR.NAR,NBR,NMBR,NMFR,PNR,RNR 
*{ IPR ( I ) , I *1 ,LR ) , (FDOCR (J ) , J  *1 ,NFR ) , 

*(  IDOCR(K ) ,K*1,NIR ) , ( ADOCR (L ) ,L*1,NAR ) , 

*{VR(M),M*M1,M2) 

IF(NR.GT.NNNR.OR.LR.GT.NNIP.OR.NFR.GT.NNF. 
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IF(JFLG.NE.l)  GO  TO  8 

IW0RDS=(10+LR+NFR+NIR+NAR+(5+LR*NAR)/2)+(LR*NR) 

C  IREC  IS  THE  RECORD  NO.  FOR  THE  LAST  RECORD  IN  THIS  SEGMENT 
IREC*{ ( IWORDS-1 )/IBUF )+IREC 
GO  TO  9 

8  IF(M2.EQ.N2)GO  TO  9 
M1=M2+1 
M2=M2+IBUF 
IF(M2.GT.N2)M2=N2 
IREC=IREC+1 

READ ( I U ' I REC , ERR-99 ) ( VR (J ) , J  =M1 ,M2 ) 

GO  TO  8 
9  CONTINUE 
C 
C 

IPOS=IPOS+l 
IUNIT(IU)=IPOS 
JUNIT(IU)=IPOS 
ISECR (IU ) =1 REC+1 
C 

IF(MSGR.EQ.O)  GO  TO  108 

IF(B210)  WRITE(6,1000)IU,NMFR,NBR,NMBR,PNR,RNR,NR,LR,NFR,NIR,NAR 
1000  FORMAT ( 1  READ  UNIT', 13,';  FILE  '  ,A6, 

*  SEGNUM' ,14, ' ;  SEGNAM  \A6,';  PN«'  A6,';  RN=',A6, 

*  N*' ,16, L-'.M,*  NF»',I4,'  NI-f,I4,'  NA-',I4) 

C 

IF(B1)  WRITE (6,1011 )  IU,NMFR,NBR,NMBR,PNR,RNR,NR,LR,NFR,NIR,NAR 
1011  FORMAT ( '  RD  ' ,14, 2X,A6,2X,I4,2X,3(A6,2X) ,16,414) 

C 

IF ( B35 )  WRITE (6,1012)( IPR ( I ),I*1,LR) 

1012F0RMATC  PARAMETERS:  '12(2X,A6)/(13X,12(2X,A6))) 

C 

IF ( .N0T.B45)  GO  TO  110 

IF( (NFR+NIR+NAR) .EQ.O)  GO  TO  110 

WRITE (6,1013) 

1013  FORMAT ( '  ADDL  DATA:') 

IF(NFR.GT.0)WR1TE(6,1100)(FD0CR(I ) ,I"1,NFR) 

IF(NIR.GT.O) WRITE (6,1101 ) ( IDOCR (I ) ,I*1,NIR) 

IF (NAR.GT.O) WRITE (6,1102 ) (ADOCR(I ) ,1*1 ,NAR) 

1100  FORMAT (10G1 1.5) 

1101  F0RMAT(1X,12I6) 

1102  FORMAT (1X.12A6) 

C 

110  IF ( .N0T.B69)  GO  TO  107 
JL-IRST*LR 
Jl^JL-LR+1 

WRITE (6 , 1014 ) (VR (I ),I*J1,JL) 

JL*(NR+IRST-1 )*LR 
Jl-JL+l-LR 

WRITE (6, 1015 )(VR (J  ),J«J1,JL) 

1014  FORMAT ( '  FIRST  CYCLE: ' ,10G11.5/(13X,10G11.5) ) 

1015  FORMAT { '  LAST  CYCLE:  '  ,10GU.5/(13X,10G11.5)) 


107  IF( .NOT. BIO)  GO  TO  108 
WRITE (6,1017) 

IQ1-IRST 

IQ2=IQ1+NR-1 

DO  106  I-IQ1.IQ2 

JL«I*LR 

J1*0L+1-LR 

WRITE (6, 1016)  I,(VR(J),J=U1,JL) 

106  CONTINUE 

1016  F0RMAT(5X,I5,3X,10G12.6) 

1017  FORMAT!//'  LISTING  OF  DATA'///) 

C 

108  IF-0 
IUP*IU 
RETURN 

C 

C 

95  IF*5 

WRITE (6 , 1005 )NNNR , NN I P , NNF , NN I , NNA , 

*  NR,LR,NFR,NIR,NAR 

1005  FORMAT (//'  A  DIMENSION  IS  TOO  SMALL.'// 

*  '  NNNR=' ,16, '  NNIP=',I6,'  NNF=',I6, 

*  '  NNI-  ,16, '  NNA=',I6//'  NR='.I6, 

*  '  LR=' ,16, '  NFR=' ,16, '  NIR*f,I6,'  NAR*',I6//) 

RETURN 

99  IF=1 

WRITE (6, 1001)  IU 
1001  FORMAT ( '  EOF  ON  UNIT  ',13) 

90  IREC®1 
IP0S=0 

IUNIT ( IU )=IPOS 
JUNIT(IU)*IPOS 
ISECR(IU)=0 
RETURN 

9090  WRITE(6,*)  '  ERROR  IN  OPENING  UNIT  ',IU 
END 
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